home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / epistat.arc / RANDOMIZ.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-08-18  |  3.8 KB  |  77 lines
  1. 1  REM                 SELECTING A RANDOM SAMPLE
  2. 2  REM             Written by Tracy L. Gustafson, M.D.
  3. 3  REM            Round Rock, Texas. Version 2.0, 1983
  4. 5  DEF SEG=&H40
  5. 6  A=PEEK(&H17): IF NOT(A AND &H20) THEN POKE &H17,(A AND (NOT &H20)) OR &H20
  6. 7  DEF SEG: KEY OFF: SCREEN 0,0: WIDTH 80: COLOR 7,0,1
  7. 10  CLEAR: DEFINT A-C,N,T,Z: DIM CX(10),CC(10),CX!(10)
  8. 15  CLS: PRINT TAB(22);"KEY";STRING$(27,205);"CLOSE"
  9. 18  PRINT TAB(22);"OPEN SELECTING A RANDOM SAMPLE OPEN"
  10. 20  PRINT TAB(22);"SCREEN";STRING$(27,205);"LOAD"
  11. 25  PRINT: PRINT: PRINT: PRINT TAB(5);"Do you want to:": PRINT
  12. 30  PRINT TAB(10);"1.)  Select a SURVEY SAMPLE from a population.":PRINT TAB(15);"Or a subgroup of cases from a larger group.": PRINT
  13. 40  PRINT TAB(10);"2.)  Assign subjects to 2 groups prospectively."
  14. 50  PRINT: PRINT TAB(10);"3.)  Assign PAIRED subjects to 2 groups prospectively." :PRINT
  15. 60  PRINT TAB(20);: INPUT "Enter choice:   ",ASUB: IF ABS(ASUB-2)>1.01 THEN BEEP: GOTO 60
  16. 62  PRINT: PRINT: PRINT: PRINT TAB(5);: ON ERROR GOTO 500
  17. 65  INPUT "Will you want numbers printed on screen or printer? (S or P)   ",A$
  18. 67  IF A$="p" OR A$="P" THEN P$="LPT1:" ELSE IF A$="S" OR A$="s" THEN P$="SCRN:" ELSE 65
  19. 70  ON ASUB GOTO 80,200,390
  20. 80  CLS: PRINT TAB(24);"SELECT A SURVEY SAMPLE": DEFSNG A,C,Z
  21. 85  PRINT TAB(24);STRING$(22,205): PRINT: PRINT TAB(15);
  22. 90  INPUT "What is the smallest number you want?   ",AMN: PRINT TAB(16);
  23. 100  INPUT "What is the largest number you want?   ",AMX: PRINT
  24. 110  PRINT TAB(7);"How many random numbers between";AMN;"and";AMX;: INPUT "do you want?    ",NM
  25. 115  ERASE CX: DIM CX(NM+1)
  26. 120  OPEN P$ FOR OUTPUT AS #1: PRINT
  27. 125  PRINT #1, TAB(16);NM;"RANDOM NUMBERS BETWEEN";AMN;"AND";AMX:PRINT #1,
  28. 130  PRINT: COLOR 23: AP=CSRLIN: PRINT TAB(30);"RANDOMIZING";: COLOR 7
  29. 135  RANDOMIZE (VAL(RIGHT$(TIME$,2))): NT=1: XN=NM/(AMX-AMN)
  30. 140  FOR Z=AMN TO AMX: RN=RND:IF RN<XN THEN CX(NT)=Z:NT=NT+1: IF NT>NM THEN 165
  31. 150  NEXT
  32. 160  IF NT<=NM THEN 135
  33. 165  TB=6: IF AMX>10000 THEN TB=10
  34. 166  LOCATE AP,1: PRINT TAB(70)
  35. 168  LOCATE AP,1: PLAY "MB T160 O3 L16 D-FA-FD-FA-F L4 D-"
  36. 170  T=1: FOR Z=1 TO NM: PRINT #1,TAB(T);CX(Z);: T=T+TB: IF T>75 THEN T=1
  37. 180  NEXT: PRINT #1,
  38. 190  CLOSE #1: GOTO 470
  39. 200  CLS: PRINT TAB(24);"ASSIGN SUBJECTS TO TWO GROUPS"
  40. 205  PRINT TAB(24);STRING$(29,205): PRINT: PRINT TAB(12);
  41. 210  PRINT " Will subjects enter the study over a period of time ": PRINT TAB(20);:INPUT "longer than 1 month? (Y or N)    ",A$: PRINT
  42. 220  AF=0: IF A$="y" OR A$="Y" THEN AF=1: PRINT "Then it is preferable to randomize SUBSETS independently to avoid seasonal bias":PRINT TAB(15);"and to asssure equal numbers of cases and controls":PRINT TAB(23);"should the study terminate early.": PRINT
  43. 230  PRINT TAB(5);: IF AF=1 THEN INPUT "How many subjects are expected to enter the study each month?   ",NM ELSE PRINT TAB(16);:INPUT "How many subjects will be in the study?  ",NM
  44. 240  ERASE CX,CC: DIM CX(NM/2+1),CC(NM/2+1)
  45. 250  OPEN P$ FOR OUTPUT AS #1: PRINT: PRINT
  46. 260  PRINT #1, TAB(16);"RANDOM ASSIGNMENT OF";NM;"CASES AND CONTROLS": PRINT #1,
  47. 270  RANDOMIZE (VAL(RIGHT$(TIME$,2))): NC=INT(NM/2): NT=1
  48. 280  FOR Z=1 TO NM: RN=RND: IF RN<0.5 THEN CX(NT)=Z: NT=NT+1: IF NT>NC THEN 300
  49. 290  NEXT: IF NT<=NC THEN 270
  50. 300  PRINT #1,"CASES = ";: T=11
  51. 310  FOR Z=1 TO NC: PRINT #1,TAB(T);CX(Z);: T=T+7: IF T>75 THEN T=11
  52. 320  NEXT: NX=1: NY=1
  53. 330  FOR Z=1 TO NM: IF CX(NX)<>Z OR NX>NC THEN CC(NY)=Z: NY=NY+1 ELSE NX=NX+1
  54. 340  NEXT
  55. 350  PRINT #1,: PRINT #1,: PRINT #1, "CONTROLS =";: T=11
  56. 360  FOR Z=1 TO NY-1: PRINT #1,TAB(T);CC(Z);: T=T+7: IF T>75 THEN T=11
  57. 370  NEXT: PRINT #1,
  58. 380  CLOSE #1: GOTO 470
  59. 390  CLS: PRINT TAB(18);"ASSIGN PAIRED SUBJECTS TO TWO GROUPS"
  60. 395  PRINT TAB(18);STRING$(36,205): PRINT: PRINT
  61. 400  PRINT TAB(12);:INPUT "How many PAIRS of subjects are in the study?  ",NM
  62. 405  PRINT TAB(7);"Each member of a pair is assigned #1 or #2 on the basis of"
  63. 406  PRINT TAB(9);"alphabetical order or some other objective criterion."
  64. 410  OPEN P$ FOR OUTPUT AS #1: PRINT: PRINT
  65. 420  PRINT #1, TAB(14);"RANDOM ASSIGNMENT OF";NM;"PAIRS TO TWO GROUPS"
  66. 430  PRINT #1,: PRINT #1,TAB(20);"#1 IN PAIR";TAB(40);"#2 IN PAIR"
  67. 440  RANDOMIZE (VAL(RIGHT$(TIME$,2))): PRINT #1,
  68. 450  FOR Z=1 TO NM:RN=RND: IF RN<0.5 THEN PRINT #1,TAB(22);"CASE";TAB(42);"CONTROL"  ELSE PRINT #1,TAB(22);"CONTROL";TAB(42);"CASE"
  69. 460  NEXT: CLOSE #1
  70. 470  PRINT: PRINT: PRINT: PRINT TAB(10);: INPUT "Do you want to perform another randomization? (Y or N)  ",A$
  71. 480  IF A$="y" OR A$="Y" THEN 10
  72. 490  END
  73. 500  IF ERL<>125 AND ERL<>260 AND ERL<>420 THEN 520
  74. 510  BEEP: IF ERR=27 OR ERR=25 THEN PRINT TAB(11);"The printer is not ready.  Check before proceeding.": PRINT TAB(24);"Press any key when ready:"
  75. 515  A$=INKEY$: IF A$="" THEN 515 ELSE RESUME
  76. 520  ON ERROR GOTO 0
  77.